home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1997 #3 / Amiga Plus CD - 1997 - No. 03.iso / pd / programmierung / alienbreed3d2_src / amos / 256wallchunk.amos / 256wallchunk.amosSourceCode
AMOS Source Code  |  1997-01-31  |  2KB  |  119 lines
  1. Set Buffer 30
  2. Reserve As Work 15,320*256
  3. Dim C(31,31)
  4. Dim R(255),G(255),B(255)
  5. Bload "ab3:includes/256pal",Start(15)
  6. S=Start(15)
  7. For A=0 To 255
  8. R(A)=Deek(S) : Add S,2
  9. G(A)=Deek(S) : Add S,2
  10. B(A)=Deek(S) : Add S,2
  11. Next 
  12.  
  13. Dim PR(31,31),PG(31,31),PB(31,31)
  14. Repeat 
  15. Screen Open 0,640,32,2,Hires
  16. Curs Off : Flash Off : Cls 0
  17. Colour 1,$FFF
  18.  
  19. F$=Fsel$("ab3:graphics/walls","","Load Wall Picture","")
  20. If F$="" Then End 
  21. Load Iff F$,1
  22.  
  23. Bload F$,Start(15)
  24. S=Hunt(Start(15) To Start(15)+10000,"CMAP")+8
  25. For A=0 To 31
  26. PR(A,0)=Peek(S) : Add S,1
  27. PG(A,0)=Peek(S) : Add S,1
  28. PB(A,0)=Peek(S) : Add S,1
  29. Next 
  30.  
  31.  
  32. T=Start(15)
  33.  
  34. For A=0 To 7
  35. Poke T,0 : Add T,1
  36. Poke T,PR(A,0) : Add T,1
  37. Poke T,PG(A,0) : Add T,1
  38. Poke T,PB(A,0) : Add T,1
  39. Next 
  40. Bsave "ab3:demo/menu/newfontpal",Start(15) To T
  41.  
  42. End 
  43.  
  44.  
  45. F$=F$-"ab3:graphics/walls/"
  46. Screen 0 : Screen To Front 0
  47. Input "Width of chunk: ";W
  48. Input "Height of chunk: ";H
  49. NOL=W/3
  50. NOL=NOL
  51. Screen 1 : Screen To Front 1
  52. X=0 : Y=0
  53. AP=Start(15)
  54.  
  55. '
  56. For A=0 To 31
  57. For Q=0 To 31
  58.  
  59. R=PR(Q,A) : G=PG(Q,A) : B=PB(Q,A)
  60.  
  61. DQ=10000000
  62. TC=0
  63. For Z=0 To 255
  64. DR=Abs(R-R(Z))
  65. DG=Abs(G-G(Z))
  66. DB=Abs(B-B(Z))
  67.  
  68. ND=(DR*3)+(DG*4)+(DB*2)
  69. If ND<DQ Then DQ=ND : TC=Z
  70. Next 
  71.  
  72. Doke AP,TC*256
  73. Add AP,2
  74.  
  75. Next 
  76. Next 
  77.  
  78. D=AP
  79. X=0 : Y=0
  80. For L=0 To NOL
  81.    For V=0 To H-1
  82.       C= Extension_12_044C(X,Y+V)
  83.        Extension_12_036E X,Y+V,0
  84.       Doke D,C : Add D,2
  85.    Next 
  86.    Add X,3
  87.    If X>=Screen Width(1) Then X=X-Screen Width(1) : Y=Y+H
  88. Next 
  89. D=AP
  90. X=1 : Y=0
  91. For L=0 To NOL
  92.    For V=0 To H-1
  93.       C= Extension_12_044C(X,Y+V)*32
  94.        Extension_12_036E X,Y+V,0
  95.       Doke D,C+Deek(D)
  96.       Add D,2
  97.    Next 
  98.    Add X,3
  99.    If X>=Screen Width(1) Then X=X-Screen Width(1) : Y=Y+H
  100. Next 
  101. D=AP
  102. X=2 : Y=0
  103. For L=0 To NOL
  104.    For V=0 To H-1
  105.       C= Extension_12_044C(X,Y+V)*32*32
  106.        Extension_12_036E X,Y+V,0
  107.       Doke D,C+Deek(D)
  108.       Add D,2
  109.    Next 
  110.    Add X,3
  111.    If X>=Screen Width(1) Then X=X-Screen Width(1) : Y=Y+H
  112. Next 
  113.  
  114. Doke D,H : Add D,2
  115.  
  116. F$=Fsel$("ab3:includes/Walls",F$,"Select Save Name","")
  117. If F$="" Then End 
  118. Bsave F$+".256wad",Start(15) To D
  119. Until 0